; The MIT License
; 
; Copyright (c) 2008 Christophe Grand
; 
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
; 
; The above copyright notice and this permission notice shall be included in
; all copies or substantial portions of the Software.
; 
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
; THE SOFTWARE

; see examples at the end of the file

(clojure/in-ns 'html)
(clojure/refer 'clojure)
(clojure/refer 'template)

(def empty-tags #{:basefont :base :img :hr :area :frame :br :input :param :meta :link :col :isindex})

(defn esc-attr [s]
	(let [sb (new StringBuilder)]
		(doseq c s
			(cond
				(= \& c) (.append sb "&amp;")
				(= \< c) (.append sb "&lt;")
				(= \> c) (.append sb "&gt;")
				(= \" c) (.append sb "&quot;")
				:else (.append sb c)))
		(. sb toString)))

(defn esc-html [s]
	(let [sb (new StringBuilder)]
		(doseq c s
			(cond
				(= \& c) (.append sb "&amp;")
				(= \< c) (.append sb "&lt;")
				(= \> c) (.append sb "&gt;")
				:else (.append sb c)))
		(. sb toString)))
		
(defn esc-cdata [s]
	(let [l (. s length)
		i (. s indexOf "]]>")]
		(if (neg? i)
			(if (. s endsWith "]")
				(str (.substring s 0 (- l 1)) "]]>]<![CDATA[")
				s)
			(str (.substring s 0 i) "]]>]]&gt;<![CDATA[" (esc-cdata (.substring s (+ i 3))))))) 

(defn esc-comment [s]
	(let [l (. s length)
		i (. s indexOf "--")]
		(if (neg? i)
			s
			(str (.substring s 0 i) "- -" (esc-comment (.substring s (+ i 2))))))) 

(defn process-attr [x]
	(let [x (default-process x)]
		(simplify `(with-escaping esc-attr ~x))))
		
(defn element? [x]
	(and (vector? x) (keyword? (first x))))

(defn write-dynattrs [m]
	(doseq [k v] m
		(write-unesc " ")
		(write (name k))
		(write-unesc "=\"")
		(write-unesc (esc-attr (str v)))
		(write-unesc "\"")))

(defn process-element [[tag & etc]]
	(let [[dynattrs etc] (if (and (or (symbol? (first etc)) (seq? (first etc))) (map? (second etc))) 
							[(first etc) (rest etc)] 
							[nil etc])
		  [attrs-maps body] (split-with map? etc)
		  attrs (apply merge {} attrs-maps)] 
		`(do
			(write-unesc "<")
			(write-unesc ~(name tag))
			~@(if dynattrs `((write-dynattrs ~dynattrs)))
			~@(mapcat (fn [[k v]] `((write-unesc " ") (write ~(name k)) (write-unesc "=\"") ~(process-attr v) (write-unesc "\""))) attrs)
			~@(if (or body (not (empty-tags tag)))
				`((write-unesc ">") ~@(if body (list (process-coll body))) (write-unesc "</") (write-unesc ~(name tag)) (write-unesc ">"))
				`((write-unesc " />")))
			)))

(def-process-fn process-html x
	(element? x) (process-element x))

(defmacro html [& etc]
	(binding [*process* process-html] 
		(simplify `(with-escaping esc-html
			~(process-coll etc)))))

(defmacro cdata
  "Don't use it to produce xhtml: browsers aren't xml parsers.
   This script: 
     <script type=\"text/javascript\">//<![CDATA[
       alert('hello]]>]]&gt;<![CDATA[')
     //]]></script>
   shows an alert reading \"hello]]>]]&gt;<![CDATA[\" and not \"hello]]>\"."
  [& etc]
	(binding [*process* default-process] 
		(simplify `(with-escaping esc-cdata
			(write-unesc "<![CDATA[")
			(nest ~(process-coll etc))
			(write-unesc "]]>")))))

(defmacro <!-- [& etc]
	(binding [*process* default-process] 
		(simplify `(with-escaping esc-comment
			(write-unesc "<!-- ")
			(nest ~(process-coll etc))
			(write-unesc " -->")))))

(defmacro with-html-output [out & etc] 	
	`(with-raw-out ~out (html ~@etc)))

(defmacro with-html [& etc] 	
	`(with-html-output *out* ~@etc))

(defn xhtml-strict [] (write-unesc "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; examples (ported from cl-who examples) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; example #1
(comment with-html-output *out* 
    (doseq [link title] [["http://zappa.com/" "Frank Zappa"]                                
                         ["http://marcusmiller.com/" "Marcus Miller"]
                         ["http://www.milesdavis.com/" "Miles Davis"]]
        (html [:a {:href link}
                  [:b title]]
                [:br])))

;;;;;; produce this code:
(comment with-raw-out *out*
  (template/with-escaping html/esc-html
    (doseq [link title] [["http://zappa.com/" "Frank Zappa"]                                
                         ["http://marcusmiller.com/" "Marcus Miller"]
                         ["http://www.milesdavis.com/" "Miles Davis"]]
      (do 
        (template/write-unesc "<a href=\"") 
        (template/write-unesc (html/esc-attr (clojure/str link))) 
        (template/write-unesc "\"><b>") 
        (template/write-unesc (html/esc-html (clojure/str title))) 
        (template/write-unesc "</b></a><br />")))))
                
;;; example #2
(comment with-html-output *out*
  [:table {:border 0 :cellpadding 4}
    (doseq i (range 0 25 5)
      (html
        [:tr {:align "right"}
          (doseq j (range i (+ i 5))
            (html
              [:td {:bgcolor (if (zero? (rem j 2)) "green" "pink")} (inc j)]))]))])
                             
;;;;;; produce this code:
(comment with-raw-out *out*
  (do
    (template/write-unesc "<table border=\"0\" cellpadding=\"4\">") 
    (template/with-escaping html/esc-html 
      (template/write (doseq i (range 0 25 5) 
                        (do 
                          (template/write-unesc "<tr align=\"right\">") 
                          (template/with-escaping html/esc-html 
                            (template/write (doseq j (range i (+ i 5)) 
                                              (do 
                                                (template/write-unesc "<td bgcolor=\"") 
                                                (template/with-escaping html/esc-attr 
                                                  (template/write (if (zero? (rem j 2)) "green" "pink"))) 
                                                  (template/write-unesc "\">") 
                                                  (template/with-escaping html/esc-html (template/write (inc j))) 
                                                  (template/write-unesc "</td>"))))) 
                          (template/write-unesc "</tr>"))))) 
    (template/write-unesc "</table>")))

                             